home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / 173amrg.zip / RSB2173A.MRG < prev    next >
Text File  |  1990-08-26  |  32KB  |  799 lines
  1. * ------------[ BLED merge (c) Ken Goosens ]-------------
  2. * Merge this against D:\172B\RBBSSUB2.BAS to produce RBBSSUB2.BAS
  3. * D:\172B\RBBSSUB2.BAS:  Date 2-10-1990  Size 134325 bytes
  4. * ------------[ Created 08-26-1990 11:28:48 ]------------
  5. * REPLACING old line(s) by new
  6. ' $linesize:132
  7. * ------[ first line different ]------
  8. ' $title: 'RBBSSUB2.BAS 17.3A, Copyright 1986 - 90 by D. Thomas Mack'   ' DA081003
  9. '  Copyright 1990 by D. Thomas Mack, all rights reserved.
  10. '  Name ...............: RBBSSUB2.BAS
  11. '  First Released .....: February 11, 1990
  12. '  Subsequent Releases.: August 26, 1990
  13. '  Copyright ..........: 1986 - 1990
  14. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  15. '     RBBS-PC.BAS utilizes a lot of common subroutines.  Those that do not
  16. '     require error trapping are incorporated within RBBSSUB 2-5 as
  17. '     separately callable subroutines in order to free up as much
  18. '     code as possible within the 64WasK code segment used by RBBS-PC.BAS.
  19. '  Parameters..........: Most parameters are passed via a COMMON statement.
  20. '
  21. ' Subroutine  Line               Function of Subroutine
  22. '   Name     Number
  23. '  Macro          1320  Check/execute macro
  24. '  AnswerIt        200  Answer the telephone when it rings
  25. '  ASCIICodes      129  Allow a CONFIG string to have any ASCII value
  26. '  BadChar         455  Check user name for invalid characters
  27. '  BadName       20235  Check for system crash attempt with bad file name
  28. '  Baud450        5507  Allow 300 baud callers to bump up to 450 baud
  29. '  CheckRatio    20096  Test upload/download ratio
  30. '  CheckMacro     1242  Checks for macro and processes
  31. '  CopyRight        97  Display RBBS-PC's copyright notice
  32. '  DEFALTU        9600  Write out the user's defaults
  33. '  DenyAccess     1386  Downgrade security so access denied
  34. '  DoorExit      10983  Set up a .BAT file to exit RBBS-PC to a "door"
  35. '  DosExit       10934  Set up a .BAT file to exit to DOS (second level)
  36. '  EditALine      2618  Edits a single line
  37. '  EditDef         120  Edit configuration parameters
  38. '  FileNameCheck 20240  Matches file name to a prefix & extension
  39. '  GetArc        20140  Handle request for verbose listing
  40. '  GetCommand      101  Get RBBS-PC's node id from command line
  41. '  GetTime        9140  Calculates callers elapsed time (hh,mm,ss)
  42. '  GoIdle           90  Release resources when waiting for keyboard input
  43. '  KillMsg        3952  Delete old or unnecessary messages
  44. '  Line25          945  Build and/or update line 25 of RBBS-PC's local screen
  45. '  LineEdit       3700  Edit a line while minimizing string space consumption
  46. '  LogError      13660  Log error message to CALLERS file
  47. '  LPrnt          1480  Subroutine to write to local display
  48. '  MLInit            8  Handle MultiLink initialization/de-initialization
  49. '  MsgProt        2055  Sets protection for a message
  50. '  MessageTo      2018  Sets who a message is to
  51. '  PageLen        5200  Change page length
  52. '  ParseIt        1637  Parses a string
  53. '  PassWrd         660  Verify user & message passwords
  54. '  PopCmdStack    1650  Get user input, 1st checking command stack
  55. '  PScrn          1483  Print to display
  56. '  QuickLPrnt     1482  Quickly writes count of blocks on file transfer
  57. '  QuickTPut      1478  Fast, but limited, "TPut" equivalent
  58. '  QuickTPut1     1478  Outputs short string following by CR LF
  59. '  RBBSExit      10992  RBBS-PC exit to transfer control to other programs
  60. '  RecoverMsg    10410  Recover a deleted message
  61. '  RemNonAlf      5100  Removes non-alpha characters from a string
  62. '  RingCaller     1636  Ring caller's bell and put message in emphasis
  63. '  SetBaud        1654  Set baud rate in the 8250 chip of the RS232 interface
  64. '  SetCrLf        1496  Set up the necessary carriage return/line feed string
  65. '  SetSection    12000  Set the proper section prompts (main, file, util, libr)
  66. '  SetThread      4554  Set up request for threading thru messages
  67. '  SkipLine       1485  Write a # of blank lines to the communications port
  68. '  SearchCmd      1238  Searches list of commands in RBBS for a request
  69. '  SecViolation   1380  Process a security violation
  70. '  SysMenu         112  Displays sysop menu/status
  71. '  SysopChat      4773  Sysop and caller chat
  72. '  TestRel         336  Tests for Reliable connect
  73. '  TGet           1498  Read a line from the communications port
  74. '  TPut           1396  Write a line to the communications port
  75. '  Trim            105  Strip leading and trailing blanks from a string
  76. '  TrimTrail       107  Strip off specified string off end of another string
  77. '  UntilRight    12878  Ask a question until user says answer is right
  78. '  UpdateU       10600  Updates the user record on loging off/exiting RBBS-PC
  79. '  VarInit         109  Initialize system variables
  80. '  ViewHelp       1330  Processes help command
  81. '  WhoCheck       2250  Checks whether a user exists in user file
  82. '  WhosOn         9801  Report status of each node - who's on
  83. '  WordInFile    10976  Find a whole word within a file/menu
  84. '
  85. '  $INCLUDE: 'RBBS-VAR.BAS'
  86. '
  87. * REPLACING old line(s) by new
  88. 97 '  $SUBTITLE: 'CopyRight - subroutine to display RBBS-PC copyright'
  89. '  $PAGE
  90. '
  91. '  NAME    -- CopyRight
  92. '
  93. '  INPUTS  --  NONE
  94. '
  95. '  OUTPUTS --  NONE
  96. '
  97. '  PURPOSE --  To display RBBS-PC's copyright notice on the local screen
  98. '
  99.       SUB CopyRight STATIC
  100.    ZWasA = (ZRecycleToDos OR ZDebug OR ZNodeRecIndex > 2)
  101.    IF ZWasA THEN _
  102.       EXIT SUB
  103.    WIDTH 80
  104.    REDIM ZOutTxt$(11)
  105. * ------[ first line different ]------
  106.    ZOutTxt$(1) = "If you use RBBS-PC 17.3A, please consider contributing to" ' DA081003
  107.    ZOutTxt$(2) = ""
  108.    ZOutTxt$(3) = "             Capital PC Software Exchange"
  109.    ZOutTxt$(4) = "                 Post Office Box 6128"
  110.    ZOutTxt$(5) = "            Silver Spring, Maryland  20906"
  111.    ZOutTxt$(6) = ""
  112.    ZOutTxt$(7) = "You are free to copy/share RBBS-PC 17.3A provided" ' DA081003
  113.    ZOutTxt$(08)= "  1.  This program is distributed unmodified"
  114.    ZOutTxt$(09)= "  2.  No fee or consideration is charged for RBBS-PC itself"
  115.    ZOutTxt$(10)= "  3.  This notice is not bypassed or removed."
  116.    CLS
  117.    KEY OFF
  118.    LOCATE ,,0
  119.    ZSnoop = -1
  120.    ZLocalUser = -1
  121.    CALL LPrnt(SPACE$(60) + "tm",1)
  122.    CALL LPrnt(SPACE$(16) + STRING$(15,205) + " U S E R W A R E " + STRING$(15,205),1)
  123.    CALL SkipLine(1)
  124.    CALL LPrnt(SPACE$(17) + "Capital PC User Group User-Supported Software",1)
  125.    CALL SkipLine (1)
  126.    CALL LPrnt(SPACE$(5) + CHR$(214) + STRING$(66,196) + CHR$(183),1)
  127.    FOR WasI = 1 TO 10
  128.       CALL LPrnt(SPACE$(5) + CHR$(186) + "    " + ZOutTxt$(WasI) + SPACE$(62 - LEN(ZOutTxt$(WasI))) + CHR$(186),1)
  129.    NEXT
  130.    CALL LPrnt(SPACE$(5) + CHR$(211) + STRING$(66,196) + CHR$(189),1)
  131.    CALL LPrnt(SPACE$(5) + "Copyright (c) 1983-90 Tom Mack, 39 Cranbury Drive, Trumbull, CT 06611",1)
  132.    CALL DelayTime (8)
  133.    ZSnoop = 0
  134.    END SUB
  135. * REPLACING old line(s) by new
  136. 336 ' $SUBTITLE: 'TestRel - Test for Reliable mode connection'
  137. ' $PAGE
  138. '
  139. '  NAME    -- TestRel
  140. '
  141. '  INPUTS  --     PARAMETER                    MEANING
  142. '                 Strng$                 String to check for reliable
  143. '
  144. '  OUTPUTS --    ZReliableMode          Reliable mode indicator
  145. '
  146. '  PURPOSE -- To test for reliable connect
  147. '
  148.     SUB TestRel (Strng$) STATIC
  149.     ZReliableMode = ZFalse
  150.     IF Strng$ = "" THEN _
  151.        EXIT SUB
  152.     IF INSTR(Strng$,"REL") OR _
  153. * ------[ first line different ]------
  154.        INSTR(Strng$,"R C") OR _                                      ' DA071701
  155.        INSTR(Strng$,"ARQ") OR _
  156.        INSTR(Strng$,"LAP") OR _
  157.        INSTR(Strng$,"AFT") OR _
  158.        INSTR(Strng$,"MNP") THEN _
  159.          ZReliableMode = -1
  160.     END SUB
  161. * REPLACING old line(s) by new
  162. 949 ZLine25$ = "Node " + _
  163.                ZNodeID$ + " " + _
  164.                ZPageStatus$ + " " + _
  165. * ------[ first line different ]------
  166.                MID$("AVL ",1, -4 * ZSysopAvail) + _                  ' DA080902
  167.                MID$("ANY ",1, -4 * ZSysopAnnoy) + _                  ' DA080902
  168.                MID$("LPT ",1, -4 * ZPrinter) + _                     ' DA080902
  169.                MID$("SYS ",1, -4 * ZSysopNext) + _                   ' DA080902
  170.                MID$("XOFF ",1,-5 * ZXOffEd) + _                      ' DA080902
  171.                MID$("CTS ",1,-4 * ZNotCTS)                           ' DA080902
  172. '
  173. '
  174. ' *  LINE 25 UPDATE ROUTINE
  175. '
  176. '
  177. * REPLACING old line(s) by new
  178. 950 IF NOT ZSnoop THEN _
  179.        EXIT SUB
  180.     ZCursorLine = CSRLIN
  181.     ZCursorRow = POS(0)
  182.     ZWasHH = LEN(ZActiveUserName$) + _
  183.          LEN(ZWasCI$) + _
  184.          LEN(ZLine25$) + _
  185. * ------[ first line different ]------
  186.          LEN(STR$(ZUserSecLevel))                                    ' DA080902
  187.     LOCATE 25,1
  188.     IF ZNetworkType = 0 THEN _
  189.        IF ZAutoDownYes THEN _
  190.           ZLockStatus$ = " AD " + _                                  ' DA080902
  191.                          ZTimeLoggedOn$ _
  192.        ELSE ZLockStatus$ = SPACE$(4) + _                             ' DA080902
  193.                            ZTimeLoggedOn$
  194.     IF ZWasHH > 63 THEN _                                            ' DA080902
  195.        ZWasHH = 0 _                                                  ' DA080902
  196.     ELSE _                                                           ' DA080902
  197.        ZWasHH = 64 - ZWasHH                                          ' DA080902
  198.     ZLine25Hold$ = ZLine25$ + _
  199.                     SPACE$(ZWasHH) + _                               ' DA080902
  200.                     STR$(ZUserSecLevel) + _
  201.                     " " + _
  202.                     ZActiveUserName$ + _
  203.                     " " + _
  204.                     ZWasCI$                                          ' DA080902
  205.     ZLine25Hold$ = LEFT$(ZLine25Hold$, 66) + " " + ZLockStatus$      ' DA080902
  206.     TempBasicWrites = ZUseBASICWrites
  207.     ZUseBASICWrites = ZTrue
  208.     CALL LPrnt(ZLine25Hold$,0)
  209.     ZUseBASICWrites = TempBasicWrites
  210.     LOCATE ZCursorLine,ZCursorRow
  211.     END SUB
  212. * REPLACING old line(s) by new
  213. 1325 ' $SUBTITLE: 'Macro - check if macro exists & process'
  214. ' $PAGE
  215. '
  216. '  NAME    -- Macro
  217. '
  218. '  INPUTS  -- PARAMETER             MEANING
  219. '             Strng$           STRING TO CHECK IF IS A MACRO
  220. '             ZMacroDrvPath$   DRIVE/PATH WHERE MACROS ARE
  221. '             ZMacroExtension$ EXTENSION OF MACROS
  222. '             MACRO.OFF        FORCE NO MACRO TO BE Found
  223. '
  224. '  OUTPUTS -- MacroFound       WHETHER A MACRO WAS Found
  225. '             Strng$           SUBSTITUTE FOR COMMANDS
  226. '             ZCommPortStack$  REST OF MACRO
  227. '                              0 IF NOT Found
  228. '
  229. '  PURPOSE -- Executes a macro if found.  Does not check if macro
  230. '             letter uses a command.
  231.      SUB Macro (Strng$,MacroFound) STATIC
  232.      MacroFound = ZFalse
  233. * ------[ first line different ]------
  234.      FilName$ = Strng$                                               ' KG071201
  235.      CALL BreakFileName (FilName$,ZWasDF$,Prefix$,WasX$,ZFalse)      ' KG071201
  236.      IF WasX$ = "" THEN _                                            ' KG071201
  237.         FilName$ = Strng$ + ZMacroExtension$                         ' KG071201
  238.      IF ZWasDF$ = "" THEN _                                          ' KG071201
  239.         FilName$ = ZMacroDrvPath$ + FilName$                         ' KG071201
  240.      CALL BadFile (FilName$,ZWasA)
  241.      IF ZWasA > 1 THEN _
  242.         EXIT SUB
  243.      CALL GRAPHICX (ZUserGraphicDefault$,FilName$,6)
  244.      IF NOT ZOK THEN _
  245.         EXIT SUB
  246.      CALL ReadDir (6,1)
  247.      IF ZErrCode > 0 THEN _
  248.         EXIT SUB
  249.      CALL CheckInt (ZOutTxt$)
  250.      IF ZErrCode > 0 OR ZUserSecLevel < ZTestedIntValue THEN _
  251.         EXIT SUB
  252.      ZWasA = INSTR(ZOutTxt$,"/")
  253.      IF ZWasA > 0 THEN _    ' Check macro contraint
  254.         WasX$ = RIGHT$(ZOutTxt$,LEN(ZOutTxt$)-ZWasA) : _
  255.         IF RIGHT$(WasX$,1) = "/" THEN _
  256.            IF ZLastCommand$ <> LEFT$(WasX$,LEN(WasX$)-1) THEN _
  257.               EXIT SUB _
  258.            ELSE GOTO 1327 _
  259.         ELSE IF LEFT$(ZLastCommand$,LEN(WasX$)) <> WasX$ THEN _
  260.                 EXIT SUB
  261. * REPLACING old line(s) by new
  262. 1331 IF SotMenu THEN _
  263.         ZFileName$ = HelpMenu$ : _
  264.         GOSUB 1350 : _
  265.         SotMenu = ZFalse
  266.      ZAnsIndex = 1
  267. * ------[ first line different ]------
  268.      ZOutTxt$ = "Help with what Command (or Topic name)" + _         ' DA071701
  269.           ZPressEnterExpert$
  270.      ZSubParm = 1
  271.      CALL TGet
  272.      IF ZSubParm = -1 THEN _
  273.         EXIT SUB
  274.      IF ZWasQ = 0 THEN _
  275.         EXIT SUB
  276.      ZLastIndex = ZWasQ
  277. * REPLACING old line(s) by new
  278. 1537 CALL CheckTime(ZAutoLogoff!, TempElapsed!, 3)
  279.      IF TempElapsed! < 30 THEN _
  280.         IF TempElapsed! <= 0 THEN _
  281.            CALL UpdtCalr ("Sleep disconnect",1) : _
  282.            ZSubParm = -1 : _
  283.            ZNo = ZTrue : _
  284.            ZSleepDisconnect = ZTrue : _
  285.            EXIT SUB _
  286.         ELSE IF SleepWarn THEN _
  287.                 SleepWarn = ZFalse : _
  288. * ------[ first line different ]------
  289.                 ZOutTxt$ = "Auto-Logoff in 30 seconds..." : _        ' DA071701
  290.                 CALL RingCaller
  291.      CALL FindFKey
  292.      IF ZSubParm < 0 THEN _
  293.         EXIT SUB
  294. * REPLACING old line(s) by new
  295. 1550 IF ZLogonActive THEN _
  296. * ------[ first line different ]------
  297.         IF (ZWasY$ = " " OR ZWasY$ = ";") AND LEN(ZUserIn$) > 0 AND _ ' MB073001
  298.            RIGHT$(ZUserIn$,1) <> " " AND RIGHT$(ZUserIn$,1) <> ";" THEN _
  299.               Parm = Parm + 1 : _
  300.               ZLogonActive = (Parm < 3) : _
  301.               ZHidden = (Parm = 2) : _
  302.               CALL LPrnt(WasX$,0) : _
  303.               GOTO 1551
  304.      IF ZHidden AND (WasX$ <> " ") THEN _
  305.         WasX$ = "."
  306.      CALL LPrnt(WasX$,0)
  307. * REPLACING old line(s) by new
  308. 1628 CALL VerifyAns
  309.      IF NOT ZOK THEN _
  310.         CALL QuickTPut1 ("Invalid answer <" + ZUserIn$(1) + ">") : _
  311.         GOTO 1500
  312.      HoldA$ = ""
  313.      ZForceKeyboard = ZFalse
  314.      IF ZMacroSave > 0 THEN _
  315.         ZGSRAra$(ZMacroSave) = ZUserIn$ : _
  316.         ZMacroSave = 0 : _
  317.         GOTO 1632
  318.      IF (ZDistantTGet > 0) OR (ZMacroTemplate$ <> "") THEN _
  319.         CALL WipeLine (38) : _
  320.         IF NOT ZNo THEN _
  321.            GOTO 1632 _
  322.         ELSE ZWasQ = 0 : _
  323.              ZMacroTemplate$ = "" : _
  324.              ZDistantTGet = 0 : _
  325.              ZNo = ZFalse : _
  326.              GOTO 1633
  327.      IF ZMacroActive THEN _
  328.         ZLastIndex = ZWasQ : _
  329.         FirstIndex = 1: _
  330. * ------[ first line different ]------
  331.         ZMacroActive = NOT EOF(6) : _                                ' KG021501
  332.         EXIT SUB
  333.      IF ZAnsIndex > 255 OR ((NOT InStack) AND INSTR(ZUserIn$,".") > 0) THEN _
  334.         EXIT SUB
  335.      IF MacroIndex THEN _
  336.         MacroIndex = 1 _
  337.      ELSE MacroIndex = ZAnsIndex
  338.      CALL NoPath (ZUserIn$(MacroIndex),Found)
  339.      IF Found THEN _
  340.         EXIT SUB
  341.      CALL CheckMacro (ZUserIn$(MacroIndex),Found)
  342.      IF Found THEN _
  343.         ZStoreParseAt = ZAnsIndex : _
  344.         GOTO 1525
  345.      EXIT SUB
  346. * REPLACING old line(s) by new
  347. 1651 IF ZAnsIndex < ZLastIndex THEN _
  348.         ZAnsIndex = ZAnsIndex + 1 : _
  349.         ZUserIn$ = ZUserIn$(ZAnsIndex) : _
  350. * ------[ first line different ]------
  351.         IF MID$(ZLastCommand$,2,1) <> " " AND (NOT ZStackC) AND ZAnsIndex > 1 AND INSTR("Cc",ZUserIn$) > 0 AND LEN(ZUserIn$) = 1 THEN _ ' KG070901
  352.            GOTO 1651 _
  353.         ELSE ZSubParm = 3 : _
  354.              CALL TGet : _
  355.              GOTO 1652
  356.      ZLastIndex = 0
  357.      ZAnsIndex = 1
  358.      ZSubParm = 1
  359.      ZSearchingAll = ZFalse
  360.      CALL TGet
  361.      ZLastIndex = ZWasQ
  362. * REPLACING old line(s) by new
  363. 2032 IF MsgTo$ <> "ALL" THEN _
  364.         IF (LEFT$(MsgTo$,4) <> "ALL " AND ZStartHash = 1) THEN _
  365. * ------[ first line different ]------
  366.            ZWasDF = INSTR(MsgTo$+" @"," @") : _                      ' KG052201
  367.            TempHashValue$ = LEFT$(MsgTo$,ZWasDF-1) : _               ' KG052201
  368.            CALL WhoCheck (TempHashValue$,Found,RcvrRecNum) : _
  369.            IF NOT Found THEN _
  370.               ZLastIndex = 0 : _
  371.               RcvrRecNum = 0 : _                                     ' KG060901
  372.               IF NOT ZReply THEN _
  373.                  ZOutTxt$ = "[R]e-enter name, Q)uit, C)ontinue" : _
  374.                  ZTurboKey = -ZTurboKeyUser : _
  375.                  ZLastIndex = 0 : _
  376.                  GOSUB 2033 : _
  377.                  ZWasZ$ = ZUserIn$(1) : _
  378.                  CALL AllCaps (ZWasZ$) : _
  379.                  IF ZWasZ$ <> "C" THEN _
  380.                     MsgTo$ = "" : _
  381.                     IF ZWasZ$ <> "Q" THEN _
  382.                        GOTO 2020
  383.      IF MsgTo$ = Temp$ THEN _
  384.         ZOutTxt$ = "Msg would be from and to SAME PERSON!  Really do this (Y,[N])" : _
  385.         ZLastIndex = 0 : _
  386.         GOSUB 2033 : _
  387.         IF NOT ZYes THEN _
  388.            MsgTo$ = ""
  389.      EXIT SUB
  390. * REPLACING old line(s) by new
  391. 2081 CALL QuickTPut1 ("Sending private mail to " + MsgTo$)           ' DA071701
  392. * REPLACING old line(s) by new
  393. * ------[ first line different ]------
  394. 2088 ZOutTxt$ = "Receiver(s) MUST know password to read msg.  Use password (Y/[N])" ' DA071701
  395.      GOSUB 2093
  396.      IF NOT ZYes THEN _
  397.         GOTO 2070
  398.      WasL = 14
  399.      WasA1$ = "!"
  400.      GOSUB 2085
  401.      CALL AllCaps (ZUserIn$)
  402.      GOTO 2092
  403. '
  404. ' ** MAKE MESSAGE KILL PROTECTED (ONLY SENDER, ADDRESSEE AND SYSOP CAN KILL) *
  405. '
  406. * REPLACING old line(s) by new
  407. * ------[ first line different ]------
  408. 2092 MsgPswd$ = WasA1$ + ZUserIn$                                    ' DA071701
  409.      EXIT SUB
  410. * REPLACING old line(s) by new
  411. 2250 ' $SUBTITLE: 'WhoCheck - Checks whether user exists'
  412. ' $PAGE
  413. '
  414. '  NAME    -- WhoCheck
  415. '
  416. '  INPUTS  --   PARAMETER                    MEANING
  417. '              WhoFind$                User to find
  418. '
  419. '  OUTPUTS --  WhoFound                Whether user found
  420. '              UserNumFound           Record # of user
  421. '
  422. '  PURPOSE --  Validate that user record exists.  Sysop
  423. '              counted as found even if lack user record.
  424. '
  425.      SUB WhoCheck (WhoFind$,WhoFound,UserNumFound) STATIC
  426.      UserNumFound = 0
  427.      IF ZStartHash <> 1 THEN _
  428.         WhoFound = ZTrue : _
  429.         EXIT SUB
  430.      Work128$ = ZUserRecord$
  431.      WhoFound = ZFalse
  432.      ToSysop = (INSTR(WhoFind$,"SYSOP") > 0 OR _
  433. * ------[ first line different ]------
  434.                 INSTR(WhoFind$,ZSysopFirstName$ + " " + ZSysopLastName$) > 0) ' KG060902
  435.      CALL OpenUser (HighestUserRecord)
  436.      FIELD 5, 128 AS ZUserRecord$
  437.      IF ToSysop THEN _
  438.         WasX$ = ZSysopPswd1$ + " " + ZSysopPswd2$ _
  439.      ELSE WasX$ = WhoFind$
  440.      ZWasDF = INSTR(WasX$+"@","@")                                   ' KG052201
  441.      WasX$ = LEFT$(WasX$,ZWasDF)                                     ' KG052201
  442.      IF LEN(WasX$) > 1 THEN _
  443.         CALL FindUser (WasX$,"",ZStartHash,ZLenHash,_
  444.                        0,0,HighestUserRecord,WhoFound,_
  445.                        UserNumFound,ZWasSL)
  446.      LSET ZUserRecord$ = Work128$
  447.      IF NOT WhoFound THEN _
  448.         IF ToSysop THEN _
  449.            WhoFound = ZTrue _
  450.         ELSE CALL QuickTPut1 (WhoFind$ + " not active user")
  451.      END SUB
  452. * REPLACING old line(s) by new
  453. 3700 ' $SUBTITLE: 'LineEdit  - subroutine to produce edited line'
  454. ' $PAGE
  455. '
  456. '  NAME    -- LineEdit
  457. '
  458. '  INPUTS  -- PARAMETER             MEANING
  459. '             ZBackArrow$
  460. '             ZBackSpace$
  461. '             ZCarriageReturn$
  462. '             ZLineFeed$
  463. '             ZLineMes$          BUFFER SPACE TO USE FOR HOLDING LINE
  464. '             ZLocalUser
  465. '             MaxLen             MAXIMUM LENGTH OF STRING TO INPUT
  466. '             MsgLine            WHERE IN ZOutTxt$() TO PUT THE EDITED LINE
  467. '             ZRightMargin
  468. '             ZSnoop
  469. '             ZStopInterrupts
  470. '             ZWaitExpired
  471. '
  472. '  OUTPUTS -- ZOutTxt$(MsgLine)  EDITED LINE
  473. '
  474. '  PURPOSE -- Subroutine to edit a line quickly using a minimum of
  475. '             string space.
  476. '
  477.      SUB LineEdit (MsgLine,MaxLen) STATIC
  478. * ------[ first line different ]------
  479.      TabToSpace = 0                                                  ' DA060901
  480.      LSET ZLineMes$ = ZOutTxt$(MsgLine)
  481.      Col = LEN(ZOutTxt$(MsgLine))
  482.      ZStopInterrupts = ZTrue
  483.      WasXXX = MaxLen - 3
  484.      ZWaitExpired = ZFalse
  485.      GOTO 3782
  486. * REPLACING old line(s) by new
  487. * ------[ first line different ]------
  488. 3730 IF TabToSpace > 0 THEN _                                        ' DA060901
  489.         WasX$ = " " : _                                              ' DA060901
  490.         TabToSpace = TabToSpace - 1 : _                              ' DA060901
  491.         GOTO 3750                                                    ' DA060901
  492.      CALL FindFKey                                                   ' DA060901
  493.      IF ZSubParm < 0 THEN _
  494.         EXIT SUB
  495.      WasX$ = ZKeyPressed$
  496.      IF WasX$ = "" THEN _
  497.         IF ZLocalUser THEN _
  498.            GOTO 3730 _
  499.         ELSE GOTO 3732
  500.      IF WasX$ = ZEscape$ THEN _
  501.         ZKeyPressed$ = WasX$ : _
  502.         EXIT SUB
  503.      SendRemote = ZTrue
  504.      WasZ = INSTR(ZLineEditChk$,WasX$)
  505.      IF WasZ < 1 THEN _
  506.         GOTO 3750 _
  507.      ELSE IF WasZ > 4 THEN _
  508.              GOTO 3870 _                                             ' DA060901
  509.      ELSE IF WasZ = 1 THEN _                                         ' DA060901
  510.              GOTO 3810                                               ' DA060901
  511.      IF ZLocalUser THEN _
  512.         GOTO 3730
  513. * REPLACING old line(s) by new
  514. * ------[ first line different ]------
  515. 3740 ON INSTR(ZLineEditChk$,WasX$) GOTO 3810,3730,3730,3730, _       ' DA060901
  516.                                    3870,3870,3870,3870,3870          ' DA060901
  517. * INSERTING new line(s)
  518. 3810 TabToSpace = 5 - (Col MOD 5)                                    ' DA060901
  519.      GOTO 3730                                                       ' DA060901
  520. * REPLACING old line(s) by new
  521. 4777 ZWasCM = 0
  522.      CALL CheckTime(TimeChatStarted!,Elapsed!, 2)
  523.      ZSecsPerSession! = ZSecsPerSession! + Elapsed!
  524.      IF NOT ZLocalUser THEN _
  525.         ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
  526. * ------[ first line different ]------
  527.      CALL QuickTPut("  Chat over.  BBS resuming",2)                  ' KG071301
  528.      END SUB
  529. * REPLACING old line(s) by new
  530. 5507 ' $SUBTITLE: 'Baud450 -- Changes 300 baud to 450'
  531. ' $PAGE
  532. '  NAME    -- Baud450
  533. '
  534. '  INPUTS  -- PARAMETER             MEANING
  535. '             ZBPS
  536. '
  537. '  OUTPUTS -- ZBPS
  538. '
  539. '  PURPOSE -- Allow 300 baud modems to bump up to 450 baud
  540. '
  541.      SUB Baud450 STATIC
  542.      IF ZBPS <> -1 THEN _
  543.         CALL QuickTPut1 ("Sorry, only 300 baud can change speed") : _
  544.         EXIT SUB
  545.      IF ZFossil THEN _
  546. * ------[ first line different ]------
  547.         CALL QuickTPut1 ("Sorry, no 450 baud under FOSSIL") : _      ' KG071301
  548.         EXIT SUB
  549.      ZOutTxt$ = "Change to 450 baud (Y,[N])"
  550.      ZTurboKey = -ZTurboKeyUser
  551.      ZSubParm = 1
  552.      CALL TGet
  553.      IF ZSubParm = -1 OR NOT ZYes THEN _
  554.         EXIT SUB
  555. * REPLACING old line(s) by new
  556. 10602 ZSubParm = 6
  557. * ------[ first line different ]------
  558.       ZWasY$ = ZLastDateTimeOn$                                      ' KG070601
  559.       CALL FileLock
  560.       CALL OpenUser (HighestUserRecord)
  561.       FIELD 5,31 AS ZUserName$, _
  562.               15 AS ZPswd$, _
  563.                2 AS ZSecLevel$, _
  564.               14 AS ZUserOption$,  _
  565.               24 AS ZCityState$, _
  566.               3 AS MachineType$, _
  567.               4 AS ZTodayDl$, _
  568.               4 AS ZTodayBytes$, _
  569.               4 AS ZDlBytes$, _
  570.               4 AS ZULBytes$, _
  571.               14 AS ZLastDateTimeOn$, _
  572.                3 AS ZListNewDate$, _
  573.                2 AS ZUserDnlds$, _
  574.                2 AS ZUserUplds$, _
  575.                2 AS ZElapsedTime$
  576. * REPLACING old line(s) by new
  577. 10604 GET 5,ZUserFileIndex
  578. * ------[ first line different ]------
  579.       LSET ZLastDateTimeOn$ = ZWasY$                                 ' KG070601
  580.       IF UpdateDefaults THEN _
  581.          CALL DefaultU
  582.       IF ZListDir THEN _
  583.          LSET ZListNewDate$ = CHR$(VAL(MID$(ZCurDate$,7,2))) + _
  584.                                CHR$(VAL(MID$(ZCurDate$,1,2))) + _
  585.                                CHR$(VAL(MID$(ZCurDate$,4,2)))
  586. * REPLACING old line(s) by new
  587. 10605 LSET ZUserDnlds$ = MKI$(ZDnlds)
  588.       LSET ZUserUplds$ = MKI$(ZUplds)
  589.       IF ZEnforceRatios THEN _
  590.          LSET ZTodayDl$ = MKS$(ZDLToday!) : _
  591.          LSET ZTodayBytes$ = MKS$(ZBytesToday!) : _
  592.          LSET ZDlBytes$ = MKS$(ZDLBytes!) : _
  593.          LSET ZULBytes$ = MKS$(ZULBytes!)
  594.       CALL CheckTime (ZUserLogonTime!, ZSecsUsedSession!, 2)
  595.       IF (NOT ZExitToDoors) AND LoggingOff THEN _
  596.          TempElapsed! = ZElapsedTime + _
  597.                        (ZSecsUsedSession! - ZTimeCredits!) / 60 : _
  598.          ZTimeCredits! = 0 _
  599.       ELSE TempElapsed! = ZElapsedTime
  600.       IF TempElapsed! < -32767 THEN _
  601.          TempElapsed! = -32767 _
  602.       ELSE IF TempElapsed! > 32767 THEN _
  603.          TempElapsed! = 32767
  604.       LSET ZElapsedTime$ = MKI$(TempElapsed!)
  605.       IF ZAdjustedSecurity THEN _
  606.          LSET ZSecLevel$ = MKI$(ZUserSecLevel)
  607.       PUT 5,ZUserFileIndex
  608.       ZSubParm = 8
  609.       CALL FileLock
  610.       IF ZActiveUserFile$ <> ZOrigUserFile$ AND LoggingOff THEN _
  611.          ZActiveUserFile$ = ZOrigUserFile$ : _
  612.          ZUserFileIndex = ZOrigUserFileIndex : _
  613.          UpdateDefaults = ZFalse : _
  614. * ------[ first line different ]------
  615.          LSET ZLastDateTimeOn$ = ZOrigDateTimeOn$ : _                ' KG070601
  616.          GOTO 10602
  617. * REPLACING old line(s) by new
  618. 10983 ' $SUBTITLE: 'DoorExit -- Setup to exit to a "door"'
  619. ' $PAGE
  620. '  NAME    -- DoorExit
  621. '
  622. '  INPUTS  -- PARAMETER             MEANING
  623. '             ZMultiLinkPresent
  624. '             ZNodeID$
  625. '             ZRBBSBat$
  626. '             ZWasZ$
  627. '
  628. '  OUTPUTS -- ZWasQ                    NUMBER OF LINES TO WRITE OUT TO
  629. '                                      ZRCTTYBat$
  630. '             ZUserIn$()               LINES TO WRITE OUT TO ZRCTTYBat$
  631. '
  632. '  PURPOSE -- Set up ZUserIn$() and ZWasQ in order to call "EXITRBBS" and
  633. '             exit RBBS-PC to invoke another program
  634. '
  635. * ------[ first line different ]------
  636.       SUB DoorExit (ReqDoorsDef) STATIC                              ' KG032502
  637.       IF ZWasZ$ = "" OR _
  638.          ZWasZ$ = "NONE" THEN _
  639.          EXIT SUB
  640.       CALL FindIt (ZWasZ$)
  641.       IF NOT ZOK THEN _
  642.          GOTO 10986
  643.       CALL BreakFileName (ZWasZ$,WasX$,ExitTo$,ExitMethod$,ZFalse)   ' KG032501
  644.       ExitMethod$ = ""
  645.       ZDooredTo$ = ExitTo$
  646.       CALL FindIt (ZDoorsDef$)
  647.       IF NOT ZOK THEN _
  648.          IF ReqDoorsDef THEN _                                       ' KG032502
  649.             EXIT SUB _                                               ' KG032502
  650.          ELSE ExitTo$ = ExitTo$ + " " + ZNodeID$ : _                 ' KG032502
  651.               GOTO 10989                                             ' KG032502
  652. * REPLACING old line(s) by new
  653. 10985 CALL ReadParms (ZOutTxt$(),8,1)
  654.       IF ZErrCode > 0 THEN _
  655. * ------[ first line different ]------
  656.          IF ReqDoorsDef THEN _                                       ' KG032502
  657.             EXIT SUB _                                               ' KG032502
  658.          ELSE ExitTo$ = ExitTo$ + " " + ZNodeID$ : _                 ' KG032502
  659.               GOTO 10989                                             ' KG032502
  660.       IF ExitTo$ <> ZOutTxt$(1) THEN _
  661.          GOTO 10985
  662.       CALL CheckInt (ZOutTxt$(2))
  663.       IF ZErrCode > 0 THEN _
  664.          ZErrCode = 0 : _
  665.          GOTO 10985
  666.       IF ZUserSecLevel < ZTestedIntValue THEN _
  667.          CALL QuickTPut1 ("Insufficient security for door") : _
  668.          EXIT SUB
  669.       WasX$ = LEFT$(ZOutTxt$(5),INSTR(ZOutTxt$(5)+" "," ")-1)
  670.       CALL FindIt (WasX$)
  671.       IF NOT ZOK THEN _
  672.          GOTO 10986
  673.       ZFileName$ = ZOutTxt$(3)
  674.       ExitMethod$ = ZOutTxt$(4)
  675.       ExitTemplate$ = ZOutTxt$(5)
  676.       ZDoorDisplay$ = ZOutTxt$(7)
  677.       DoorTime$ = ZOutTxt$(8)
  678.       CALL AskUsers
  679.       CALL SmartText (ExitTemplate$,ZFalse,ZFalse)
  680.       CALL MetaGSR (ExitTemplate$,ZFalse)
  681.       ExitTo$ = ExitTemplate$
  682.       GOTO 10989
  683. * REPLACING old line(s) by new
  684. 10989 IF ZTransferFunction = 3 THEN _
  685.          ZWasY$ = "Registration" _
  686.       ELSE ZWasY$ = ZDooredTo$
  687.       ZOutTxt$ = ZWasY$ + _
  688.            " door opened at " + _
  689.            TIME$ + _
  690.            " on " + _
  691.            DATE$
  692.       ZSubParm = 5
  693.       CALL TPut
  694.       CALL UpdtCalr (ZDooredTo$ + " door opened!",2)
  695.       CLOSE 2
  696.       OPEN "O",2,"DORINFO" + _
  697.                  ZNodeFileID$ + _
  698.                  ".DEF"
  699.       PRINT #2,ZRBBSName$
  700.       PRINT #2,ZSysopFirstName$
  701.       PRINT #2,ZSysopLastName$
  702.       IF ZLocalUser THEN _
  703.          PRINT #2,"COM0" _
  704.       ELSE PRINT #2,ZComPort$
  705.       ZUserIn$ = MID$(ZBaudParity$,INSTR(ZBaudParity$," B"))
  706.       PRINT #2,ZTalkToModemAt$;ZUserIn$
  707.       PRINT #2,ZNetworkType
  708.       IF ZGlobalSysop THEN _
  709.          PRINT #2,"SYSOP" : _
  710.          PRINT #2,"" _
  711.       ELSE PRINT #2,ZFirstName$ : _
  712.            PRINT #2,ZLastName$
  713.       PRINT #2,ZCityState$
  714.       PRINT #2,ZWasGR
  715.       PRINT #2,ZUserSecLevel
  716.       CALL TimeRemain (MinsRemaining)
  717.       CALL CheckInt (DoorTime$)
  718.       IF ZErrCode = 0 AND ZTestedIntValue > 0 THEN _
  719.          IF MinsRemaining > ZTestedIntValue THEN _
  720.             MinsRemaining = ZTestedIntValue
  721.       PRINT #2,INT(MinsRemaining)
  722.       PRINT #2,ZFossil
  723.       IF ExitMethod$ = "S" THEN _
  724. * ------[ first line different ]------
  725.          CLOSE 4 : _                                                 ' KG052401
  726.          CALL ShellExit (ExitTemplate$) : _
  727.          ZPrevCaller$ = "" : _                                       ' KG052401
  728.          CALL SetCall : _                                            ' KG052401
  729.          ZExitToDoors = ZTrue : _
  730.          CALL BufFile (ZDoorDisplay$,WasX) : _
  731.          CALL DoorReturn _
  732.       ELSE ZOutTxt$(1) = ZDiskForDos$ + _
  733.                   "COMMAND /C " + _
  734.                   ExitTo$ : _
  735.            ZOutTxt$(2) = ZRBBSBat$ : _
  736.            CALL RBBSExit (ZOutTxt$(),2)
  737.       END SUB
  738. * REPLACING old line(s) by new
  739. 20100 IF NOT (ZRatioRestrict# > 0 AND TellUser) THEN _
  740.          EXIT SUB
  741.       IF ZByteMethod <= 1 THEN _
  742.          GOTO 20105
  743.       IF Today# < 0 THEN _
  744.          ZOutTxt$ = "Sorry, Daily download limit of" + _
  745.               STR$(ZRatioRestrict#) + " " + _
  746.               Method$ + " Reached" : _
  747.          ZOK = ZFalse _
  748. * ------[ first line different ]------
  749.       ELSE ZOutTxt$ = "Download balance:" + _                        ' KG071301
  750.                 STR$(Today#) + _
  751.                 " " + _
  752.                 Method$ : _
  753.            ZOK = ZTrue
  754.       ZSubParm = 5
  755.       CALL TPut
  756.       CALL SkipLine(1)
  757.       EXIT SUB
  758. '
  759. * REPLACING old line(s) by new
  760. 20141 IF ZAnsIndex >= ZLastIndex THEN _
  761. * ------[ first line different ]------
  762.          IF LEN(ZDefaultExtension$) > 0 THEN _                       ' KG080101
  763.             CALL QuickTPut1 ("Default extension is "+ZDefaultExtension$) ' KG080101
  764.       ZOutTxt$ = "What compressed file(s)" + ZPressEnterExpert$
  765.       CALL PopCmdStack
  766.       IF ZSubParm = -1 OR ZWasQ = 0 THEN _
  767.          EXIT SUB
  768. * REPLACING old line(s) by new
  769. 20143 ZWasZ$ = ZUserIn$(ZAnsIndex)
  770. * ------[ first line different ]------
  771.       WasZ$ = ZWasZ$                                                 ' KG022205
  772.       CALL AllCaps (ZWasZ$)
  773.       CALL BreakFileName (ZWasZ$,Drive$,Prefix$,Ext$,ZFalse)
  774.       IF Ext$ = "" THEN _
  775.          Ext$ = ZDefaultExtension$ : _
  776.          ZWasZ$ = ZWasZ$ + "." + ZDefaultExtension$
  777.       ZFileNameHold$ = ZWasZ$
  778.       ZFileName$ = ZWasZ$
  779.       CALL BadFile (Prefix$,BadFileNameIndex)
  780.       ON BadFileNameIndex GOTO 20144,20146,20147
  781. * REPLACING old line(s) by new
  782. * ------[ first line different ]------
  783. 20145 CALL RotorsDir (ZFileName$,ZSubDir$(),ZSubDirCount + (NOT ZSysop),ZTrue,"V") ' KG022204
  784.       IF ZOK THEN _
  785.          GOTO 20148
  786. * REPLACING old line(s) by new
  787. * ------[ first line different ]------
  788. 20146 ZWasZ$ = WasZ$ + _                                             ' KG022205
  789.            " not found!"
  790.       CALL UpdtCalr (ZWasZ$,2)
  791.       ZOutTxt$ = ZWasZ$ + _
  792.            " Type correct filename" + ZPressEnterExpert$
  793.       ZSubParm = 1
  794.       CALL TGet
  795.       IF ZSubParm = -1 OR ZWasQ = 0 THEN _
  796.          RETURN
  797.       ZUserIn$(ZAnsIndex) = ZUserIn$(1)
  798.       GOTO 20143
  799.